SetOptions[EvaluationNotebook[],CellContext->Notebook]

1. The tangent space and normal to a surface

Consider a trous given by parametric equations:

tor[θ_,ϕ_]:={(4+Cos[θ]) Sin[ϕ],Sin[θ],(4+Cos[θ]) Cos[ϕ]}

tor[{θ_,ϕ_}]:=tor[θ,ϕ]

The Jacobi matrix gives two tangent vectors to the surface, which we can normalize to obtain two unit tangent vectors.

tg[f_][{x_,y_}]:=Normalize/@(D[f[u,v],{{u,v}}]/.{u->x,v->y}//Transpose)

tg[tor][{1,2}]//N

nr[f_][{x_,y_}]:=-Normalize[Cross@@(Transpose[D[f[u,v],{{u,v}}]])]/.{u->x,v->y}

nr[tor][{Pi,-Pi}]

tgVects[f_][{u_,v_}]:=Arrow[Tube[{f[u,v],f[u,v]+##},.02]]&/@tg[f][{u,v}]

normVect[f_][{u_,v_}]:=Arrow[Tube[{f[u,v],f[u,v]+nr[f][{u,v}]},.02]]

ttr=ParametricPlot3D[tor[θ,ϕ],{θ,-Pi,Pi},{ϕ,-Pi,Pi},Axes->False,Mesh->None,ColorFunction->(Directive[Opacity[0.4],Green]&)];

Manipulate[Show[ttr,Graphics3D[{Thick, Red,Arrowheads[Small],normVect[tor][p]}],PlotRange->{{-6,6},{-6,6},{-6,6}}],{{p,{0,0}},{-Pi,-Pi},{Pi,Pi},Slider2D},SaveDefinitions->True]

Manipulate[Show[ttr,Graphics3D[{Thick, Red,Arrowheads[Small],normVect[tor][p],Blue,tgVects[tor][p]}],PlotRange->{{-6,6},{-6,6},{-6,6}}],{{p,{0,0}},{-Pi,-Pi},{Pi,Pi}},SaveDefinitions->True]

2. Metrics on a surface

Let  f: D-> (ℝ^3) be a coordinate patch for a surface S⊂(ℝ^3) and D is an open disk in (ℝ^2).  We define 4 functions on D.

ee[f_][u_,v_]:=Simplify[Derivative[1,0][f][u,v].Derivative[1,0][f][u,v]]

ff[f_][u_,v_]:=Simplify[Derivative[1,0][f][u,v].Derivative[0,1][f][u,v]]

gg[f_][u_,v_]:=Simplify[Derivative[0,1][f][u,v].Derivative[0,1][f][u,v]]

hh[f_][u_,v_]:=(Sqrt[ee[f][u,v] gg[f][u,v]-((ff[f][u,v])^2)])

The Metric form

metricForm[f_][u_,v_]:=ee[f][u,v] \[DifferentialD](u^2)+2 ff[f][u,v] \[DifferentialD]u \[DifferentialD]v+gg[f][u,v] \[DifferentialD](v^2)

metricForm[tor][u,v]

sph[r_][u_,v_]:=r {Cos[u]Cos[v],Cos[v]Sin[u],Sin[v]}

metricForm[sph[r]][u,v]

parab[s_,t_]:={s,t,t^2-s^2}

metricForm[parab][u,v]

hh[parab][u,v]//Simplify

infinitesimal Area

infArea[f_][u_,v_]:=(Sqrt[ee(f)(u,v) gg(f)(u,v)-(((ff(f)(u,v)))^2)])

infArea[tor][u,v]

sph[r_][θ_,ϕ_]:=r {Cos[θ]Cos[ϕ],Cos[ϕ]Sin[θ],Sin[ϕ]}

ParametricPlot3D[sph[1][θ,ϕ],{θ,0,2Pi},{ϕ,-Pi/2,Pi/2}]

Assuming[r>0,Simplify[Integrate[infArea[sph[r]][u,v],{u,0,2Pi},{v,-Pi/2,Pi/2}]]]

The torus

tt[a_,b_][s_,t_]:={Cos[t] (b+ a Cos[s]),Sin[t](b+ a Cos[s]),a Sin[s]}

Manipulate[ParametricPlot3D[tt[a,b][s,t],{s,0,2Pi},{t,0,2Pi}],{{a,1,"a"},0.1,3},{{b,1,"b"},0.1,3},SaveDefinitions->True]

Integrate[infArea[tt[a,b]][u,v],{u,0,2Pi},{v,0,2Pi},Assumptions->{a>0,b>0,b>a,0<u<2Pi}]

Simplify[infArea[tt[a,b]][u,v],{a>0,b>a,0<u<2Pi}]

Second Fundamental Form

eee[f_][u_,v_]:=Simplify[((Det[{Derivative[2,0][f][u,v],Derivative[1,0][f][u,v],Derivative[0,1][f][u,v]}])/(Sqrt[ee[f][u,v] gg[f][u,v]-((ff[f][u,v])^2)]))]

fff[f_][u_,v_]:=Simplify[((Det[{Derivative[1,1][f][u,v],Derivative[1,0][f][u,v],Derivative[0,1][f][u,v]}])/(Sqrt[ee[f][u,v] gg[f][u,v]-((ff[f][u,v])^2)]))]

ggg[f_][u_,v_]:=Simplify[((Det[{Derivative[0,2][f][u,v],Derivative[1,0][f][u,v],Derivative[0,1][f][u,v]}])/(Sqrt[ee[f][u,v] gg[f][u,v]-((ff[f][u,v])^2)]))]

ggg[tt[1,1]][u,v]

weingarten[f_][u_,v_]:={{eee[f][u,v]*gg[f][u,v]-fff[f][u,v]*ff[f][u,v],fff[f][u,v]*ee[f][u,v]-eee[f][u,v]*ff[f][u,v]},{fff[f][u,v]*gg[f][u,v]-ggg[f][u,v]*ff[f][u,v],ggg[f][u,v]*ee[f][u,v]-fff[f][u,v]*ff[f][u,v]}}/(ee[f][u,v]*gg[f][u,v]-ff[f][u,v]^2)

gcurvature[x_][u_,v_]:=Simplify[(Det[{Derivative[2,0][x][u,v],Derivative[1,0][x][u,v],Derivative[0,1][x][u,v]}] Det[{Derivative[0,2][x][u,v],Derivative[1,0][x][u,v],Derivative[0,1][x][u,v]}]-((Det[{Derivative[1,1][x][u,v],Derivative[1,0][x][u,v],Derivative[0,1][x][u,v]}])^2))/(((Derivative[1,0][x][u,v].Derivative[1,0][x][u,v] Derivative[0,1][x][u,v].Derivative[0,1][x][u,v]-Derivative[1,0][x][u,v].Derivative[0,1][x][u,v]))^2)]

gcurvature[sph[r]][u,v]//FullSimplify

mcurvature[x_][u_,v_]:=Simplify[(Det[{Derivative[2,0][x][u,v],Derivative[1,0][x][u,v],Derivative[0,1][x][u,v]}] Derivative[0,1][x][u,v].Derivative[0,1][x][u,v]-2 Det[{Derivative[1,1][x][u,v],Derivative[1,0][x][u,v],Derivative[0,1][x][u,v]}] Derivative[1,0][x][u,v].Derivative[0,1][x][u,v]+Det[{Derivative[0,2][x][u,v],Derivative[1,0][x][u,v],Derivative[0,1][x][u,v]}] Derivative[1,0][x][u,v].Derivative[1,0][x][u,v])/(2 (((-(((Derivative[1,0][x][u,v].Derivative[0,1][x][u,v]))^2)+Derivative[0,1][x][u,v].Derivative[0,1][x][u,v] Derivative[1,0][x][u,v].Derivative[1,0][x][u,v]))^(3/2)))]

FullSimplify[mcurvature[sph[r]][u,v],Assumptions->{-Pi/2≤v≤Pi/2,r>0}]

Slow

gaussiancurvature[x_][u_, v_] := Simplify[
          (eee[x][u, v]*ggg[x][u, v] - fff[x][u, v]^2)/
           (ee[x][u, v]*gg[x][u, v] -
                     ff[x][u, v]^2)]

mcurvature[x_][u_,v_]:=Simplify[
          (eee[x][u, v]*gg[x][u, v] -
                     2*fff[x][u, v]*ff[x][u, v] +
              ggg[x][u, v]*ee[x][u, v])/
           (2*(ee[x][u, v]*gg[x][u, v] -
                       ff[x][u, v]^2))]

torus[a_,b_,c_][u_,v_]:={(a+b Cos[v])Cos[u],(a+b Cos[v])Sin[u],c Sin[v]}

tr=ParametricPlot3D[torus[1,0.6,1][u,v],{u,0,2Pi},{v,0,2Pi},Mesh->None,ColorFunction->Function[{x,y,z},Directive[Opacity[0.2],Red]]]

Manipulate[Show[Graphics3D[Style[Text[gcurvature[torus[1,0.6,1]][u,v],torus[1,0.6,1][u,v]],{White,Thick}]],tr],{{u,0,"θ"},0,2Pi,Appearance->"Labeled"},{{v,0,"ϕ"},0,2Pi,Appearance->"Labeled"},SaveDefinitions->True]

Torus colored by curvature (positive vs negative)

gcolorfunction1[u_,v_]:=Which[gcurvature[torus[1,0.6,1]][u,v]>0,0.5,gcurvature[torus[1,0.6,1]][u,v]<0,1,True,0.1];

tr1=ParametricPlot3D[torus[1,0.6,1][u,v],{u,0,2Pi},{v,0,2Pi},Mesh->None,ColorFunctionScaling->False,ColorFunction->Function[{x,y,z,u,v},Hue[gcolorfunction1[u,v]]]]

Manipulate[Show[{Graphics3D[{PointSize[0.02],Point[torus[1,0.6,1][u,v]],Style[Text[gcurvature[torus[1,0.6,1]][u,v],torus[1,0.6,1][u,v]],Black]}],tr1}],{{u,0,"θ"},0,2Pi,Appearance->"Labeled"},{{v,0,"ϕ"},0,2Pi,Appearance->"Labeled"},SaveDefinitions->True]

Torus colored by curvature

max=Max[Table[gcurvature[torus[1,0.6,1]][u,v],{u,0,2Pi,0.1},{v,0,2Pi,0.1}]]

min=Min[Table[gcurvature[torus[1,0.6,1]][u,v],{u,0,2Pi,0.1},{v,0,2Pi,0.1}]]

gcolorfunction3[u_,v_]:=Which[gcurvature[torus[1,0.6,1]][u,v]>0,RGBColor[Rescale[gcurvature[torus[1,0.6,1]][u,v],{0,max}],0,0],gcurvature[torus[1,0.6,1]][u,v]<0,RGBColor[0,0,Rescale[-gcurvature[torus[1,0.6,1]][u,v],{0,-min}]],True,RGBColor[0,0,0]]

tr3=ParametricPlot3D[torus[1,0.6,1][u,v],{u,0,2Pi},{v,0,2Pi},Mesh->None,ColorFunctionScaling->False,ColorFunction->Function[{x,y,z,u,v},gcolorfunction3[u,v]]]

Manipulate[Show[Graphics3D[Style[Text[gcurvature[torus[1,0.6,1]][u,v],torus[1,0.6,1][u,v]],White]],tr3],{{u,0,"θ"},0,2Pi,Appearance->"Labeled"},{{v,0,"ϕ"},0,2Pi,Appearance->"Labeled"},SaveDefinitions->True]